unit gmEvents;

interface

{$INCLUDE gmConfig.inc}

uses
  SysUtils, {$IFDEF DELPHI6_UP}Variants,{$ENDIF} ActiveX, BrowserTools,
  JScriptObjects, gmBase, HTMLObjects;

const
  NoInstance                         = 'No Instance';
  NoHandler                          = 'No Handler';

  EventMethod_AddDomListener         = 'addDomListener';
  EventMethod_AddDomListenerOnce     = 'addDomListenerOnce';
  EventMethod_AddListener            = 'addListener';
  EventMethod_AddListenerOnce        = 'addListenerOnce';
  EventMethod_Bind                   = 'bind';
  EventMethod_ClearInstanceListeners = 'clearInstanceListeners';
  EventMethod_ClearListeners         = 'clearListeners';
  EventMethod_Forward                = 'forward';
  EventMethod_H                      = 'H';
  EventMethod_Hi                     = 'hi';
  EventMethod_RemoveListener         = 'removeListener';
  EventMethod_Trigger                = 'trigger';
  EventMethod_X                      = 'X';
  EventMethod_Xc                     = 'Xc';
  EventProp_Mb                       = 'Mb';
  EventProp_Re                       = 're';

  MouseEventProp_LatLng              = 'latLng';

type
  TMapsEventListener = class;

  TEvent = class(TJScriptObject)
  private
    procedure SetMb(Value: IDispatch);
    procedure SetRe(Value: Boolean);
    function GetMb: IDispatch;
    function GetRe: Boolean;
  protected
    procedure Hi;
    function H(a: OleVariant; b: OleVariant; c: OleVariant; d: OleVariant): OleVariant;
    function X(a: OleVariant; b: OleVariant; c: OleVariant; d: OleVariant): OleVariant;
    function Xc(a: OleVariant; b: OleVariant): OleVariant;
    function Bind(a: OleVariant; b: OleVariant; c: OleVariant; d: OleVariant): OleVariant;
    function Forward(a: OleVariant; b: OleVariant; c: OleVariant): OleVariant;
    property Mb: IDispatch read GetMb write SetMb;
    property Re: Boolean read GetRe write SetRe;
  public
    class function IsObjectFromDisp(Disp: IDispatch): Boolean; override;
    procedure ClearInstanceListeners(Instance: TJScriptObject);
    procedure ClearListeners(Instance: TJScriptObject; EventName: String);
    procedure RemoveListener(Listener: TMapsEventListener);
    procedure Trigger(Instance: TJScriptObject; EventName: String; Args: array of OleVariant);
    function AddDomListener(Instance: TJScriptObject; EventName: String; Handler: TJScriptFunction): TMapsEventListener;
    function AddDomListenerOnce(Instance: TJScriptObject; EventName: String; Handler: TJScriptFunction): TMapsEventListener;
    function AddListener(Instance: TJScriptObject; EventName: String; Handler: TJScriptFunction): TMapsEventListener;
    function AddListenerOnce(Instance: TJScriptObject; EventName: String; Handler: TJScriptFunction): TMapsEventListener;
  end;

  TMapsEventListener = class(TJScriptObject)
  public
    class function IsObjectFromDisp(Disp: IDispatch): Boolean; override;
  end;

  TMouseEvent = class(TJScriptObject)
  private
    FLatLng: TLatLng;
    function GetLatLng: TLatLng;
  protected
  public
    destructor Destroy; override;
    class function IsObjectFromDisp(Disp: IDispatch): Boolean; override;
    property LatLng: TLatLng read GetLatLng;
  end;

  TMapMouseEvent = procedure(Sender: TObject; MouseEvent: TMouseEvent) of object;
  TMapEventEvent = procedure(Sender: TObject; Event: HTMLObjects.TEvent) of object;
  TMapEvent = procedure of object;

function CreateJScriptFunction(Script: TCustomScript; Method: TExternalProc; ExternalName: String = ''): TJScriptFunction; overload;
function CreateJScriptFunction(Script: TCustomScript; Method: TExternalFunc; ExternalName: String = ''): TJScriptFunction; overload;
function CreateEventWrapper(Script: TCustomScript; Dispatch: IDispatch): TEvent;
function CreateMouseEventWrapper(Script: TCustomScript; Dispatch: IDispatch): TMouseEvent;

implementation

function CreateEventWrapper(Script: TCustomScript; Dispatch: IDispatch): TEvent;
begin
  Result:=TEvent.Create(Script,Dispatch);
end;

function CreateMouseEventWrapper(Script: TCustomScript; Dispatch: IDispatch): TMouseEvent;
begin
  Result:=TMouseEvent.Create(Script,Dispatch);
end;

function CreateJScriptFunction(Script: TCustomScript; Method: TExternalProc; ExternalName: String = ''): TJScriptFunction; overload;
begin
  Result:=nil;
  if not assigned(Script) or not assigned(Method)
    then Exit;
  Result:=Script.NewFunction(Method,ExternalName);
end;

function CreateJScriptFunction(Script: TCustomScript; Method: TExternalFunc; ExternalName: String = ''): TJScriptFunction; overload;
begin
  Result:=nil;
  if not assigned(Script) or not assigned(Method)
    then Exit;
  Result:=Script.NewFunction(Method,ExternalName);
end;

//------------------------------------------------------------------------------
//TEvent

class function TEvent.IsObjectFromDisp(Disp: IDispatch): Boolean;
begin
  Result:=(GetJSObjectType(Disp)=otObject) and
          ObjectHasMembers(Disp,[EventMethod_AddDomListener,
                                 EventMethod_AddDomListener,
                                 EventMethod_AddDomListenerOnce]);
end;

function TEvent.AddDomListener(Instance: TJScriptObject; EventName: String; Handler: TJScriptFunction): TMapsEventListener;
var
  DomListener: OleVariant;
begin
  Result:=nil;
  if not assigned(Instance)
    then raise Exception.Create(NoInstance);
  if not assigned(Handler)
    then raise Exception.Create(NoInstance);
  DomListener:=Exec(EventMethod_AddDomListener,[Instance.Disp,EventName,Handler.Disp]);
  if VarIsValidDispatch(DomListener)
    then Result:=TMapsEventListener.Create(Script,DomListener);
end;

function TEvent.AddDomListenerOnce(Instance: TJScriptObject; EventName: String; Handler: TJScriptFunction): TMapsEventListener;
var
  DomListener: OleVariant;
begin
  Result:=nil;
  if not assigned(Instance)
    then raise Exception.Create(NoInstance);
  if not assigned(Handler)
    then raise Exception.Create(NoInstance);
  DomListener:=Exec(EventMethod_AddDomListenerOnce,[Instance.Disp,EventName,Handler.Disp]);
  if VarIsValidDispatch(DomListener)
    then Result:=TMapsEventListener.Create(Script,DomListener);
end;

function TEvent.AddListener(Instance: TJScriptObject; EventName: String; Handler: TJScriptFunction): TMapsEventListener;
var
  Listener: OleVariant;
begin
  Result:=nil;
  if not assigned(Instance)
    then raise Exception.Create(NoInstance);
  if not assigned(Handler)
    then raise Exception.Create(NoInstance);
  Listener:=Exec(EventMethod_AddListener,[Instance.Disp,EventName,Handler.Disp]);
  if VarIsValidDispatch(Listener)
    then Result:=TMapsEventListener.Create(Script,Listener);
end;

function TEvent.AddListenerOnce(Instance: TJScriptObject; EventName: String; Handler: TJScriptFunction): TMapsEventListener;
var
  Listener: OleVariant;
begin
  Result:=nil;
  if not assigned(Instance)
    then raise Exception.Create(NoInstance);
  if not assigned(Handler)
    then raise Exception.Create(NoInstance);
  Listener:=Exec(EventMethod_AddListenerOnce,[Instance.Disp,EventName,Handler.Disp]);
  if VarIsValidDispatch(Listener)
    then Result:=TMapsEventListener.Create(Script,Listener);
end;

function TEvent.Bind(a: OleVariant; b: OleVariant; c: OleVariant; d: OleVariant): OleVariant;
begin
  Result:=Exec(EventMethod_Bind,[a,b,c,d]);
end;

procedure TEvent.ClearInstanceListeners(Instance: TJScriptObject);
begin
  if not assigned(Instance)
    then raise Exception.Create(NoInstance);
  Exec(EventMethod_ClearInstanceListeners,[Instance.Disp]);
end;

procedure TEvent.ClearListeners(Instance: TJScriptObject; EventName: String);
begin
  if not assigned(Instance)
    then raise Exception.Create(NoInstance);
  Exec(EventMethod_ClearListeners,[Instance.Disp,EventName]);
end;

function TEvent.Forward(a: OleVariant; b: OleVariant; c: OleVariant): OleVariant;
begin
  Result:=Exec(EventMethod_Forward,[a,b,c]);
end;

function TEvent.H(a: OleVariant; b: OleVariant; c: OleVariant; d: OleVariant): OleVariant;
begin
  Result:=Exec(EventMethod_H,[a,b,c,d]);
end;

procedure TEvent.Hi;
begin
  Exec(EventMethod_Hi);
end;

function TEvent.GetMb: IDispatch;
begin
  Result:=GetPropAsDispatch(EventProp_Mb);
end;

procedure TEvent.SetMb(Value: IDispatch);
begin
  if assigned(Value)
    then SetProp(EventProp_Mb,Value,true);
end;

function TEvent.GetRe: Boolean;
begin
  Result:=GetPropAsBoolean(EventProp_Re);
end;

procedure TEvent.SetRe(Value: Boolean);
begin
  SetProp(EventProp_Re,Value,true);
end;

procedure TEvent.RemoveListener(Listener: TMapsEventListener);
begin
  Exec(EventMethod_RemoveListener,Listener);
end;

procedure TEvent.Trigger(Instance: TJScriptObject; EventName: String; Args: array of OleVariant);
{$IFNDEF CAN_OVERLOAD}
var
  a: array[0..1] of OleVariant;
{$ENDIF}
begin
  if not assigned(Instance)
    then raise Exception.Create(NoInstance);
{$IFNDEF CAN_OVERLOAD}
  a[0]:=Instance.Disp;
  a[1]:=EventName;
  Exec(EventMethod_Trigger,Append(a,Args));
{$ELSE}
  Exec(EventMethod_Trigger,Append([Instance.Disp,EventName],Args));
{$ENDIF}
end;

function TEvent.X(a: OleVariant; b: OleVariant; c: OleVariant; d: OleVariant): OleVariant;
begin
  Result:=Exec(EventMethod_X,[a,b,c,d]);
end;

function TEvent.Xc(a: OleVariant; b: OleVariant): OleVariant;
begin
  Result:=Exec(EventMethod_Xc,[a,b]);
end;

//------------------------------------------------------------------------------
//TMapsEventListener

class function TMapsEventListener.IsObjectFromDisp(Disp: IDispatch): Boolean;
begin
  Result:=false; {(GetJSObjectType(Disp)=otObject) and
          ObjectHasMembers(Disp,[,,]); }
end;

//------------------------------------------------------------------------------
//TMouseEvent

destructor TMouseEvent.Destroy;
begin
  FLatLng.Free;
  inherited;
end;

class function TMouseEvent.IsObjectFromDisp(Disp: IDispatch): Boolean;
begin
  Result:=(GetJSObjectType(Disp)=otObject) and
          ObjectHasMembers(Disp,[MouseEventProp_LatLng]);
end;

function TMouseEvent.GetLatLng: TLatLng;
begin
  Result:=TLatLng(GetPropAsObject(MouseEventProp_LatLng,TLatLng,FLatLng));
end;

end.
